\ MathLib 05.3.1 NAB
\ original 01.4.25 JCF

needs zstrings
needs NewFloatMgr
needs inifini

module MathLib
expose-module NewFloatMgr

: 2>r2>r4>r
DUP (2>r) (2>r) (4>r) DROP ; inline
: 2>r4>r4>r
DUP (2>r) (4>r) (4>r) DROP ; inline

VARIABLE MathLibRef
DFVARIABLE MathLibDF
DFVARIABLE MathLibDF1
VARIABLE MathLibN
2VARIABLE MathLibD
: &MathLibDF.
MathLibDF >abs ;

:NONAME \ close
MathLibN >abs MathLibRef @
(hex) A802 systrap d0.L DROP THROW
MathLibN @ 0= IF
MathLibRef @ SysLibRemove THEN
0 MathLibRef ! ;

:NONAME \ open
[ SWAP ]
MathLibRef >abs
z" MathLib" DROP >abs
SysLibFind if
MathLibRef >abs [ID] MthL [ID] libr
SysLibLoad throw  then
1 ( version ) MathLibRef @
(hex) A801 systrap d0.L DROP IF
[ OVER COMPILE, ]
-38 THROW THEN
2DROP
[ SWAP ] ;

:NONAME
[ SWAP ] literalxt CATCH IF
0 MathLibRef !
ELSE
[ ROT ] literalxt DUP
['] add-fini CATCH ?DUP IF
>R EXECUTE R> THROW
ELSE DROP
THEN THEN
; DUP add-ini EXECUTE

:NONAME
(2r>) MathLibRef @
DUP 0= -21 and THROW
>R
baretrap 2>R ;

: (dfidfo)
r[
&MathLibDF. 2>R (4>r)
[ OVER COMPILE, ]
]r
MathLibDF DF@DF ;

: >(dfidfo) DROP
postpone literal
[ ' (dfidfo) LITERAL ] COMPILE,
[ ' (traplistbuilder) LITERAL ] SWAP ;
IMMEDIATE

public:

' (traplistbuilder)

:NONAME
postpone LITERAL
[ ROT LITERAL ] COMPILE,
[ OVER LITERAL ] SWAP ; IMMEDIATE

(hex) A805 SWAP ROT

EXECUTE DFACOS >(dfidfo) ;
EXECUTE DFASIN >(dfidfo) ;
EXECUTE DFATAN >(dfidfo) ;
EXECUTE DFATAN2
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE DFCOS >(dfidfo) ;
EXECUTE DFSIN >(dfidfo) ;
EXECUTE DFTAN >(dfidfo) ;
EXECUTE DFSINCOS
r[
&MathLibDF.
MathLibDF1 >abs
2>r2>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
MathLibDF1 DF@DF
;
EXECUTE DFCOSH >(dfidfo) ;
EXECUTE DFSINH >(dfidfo) ;
EXECUTE DFTANH >(dfidfo) ;
EXECUTE DFACOSH >(dfidfo) ;
EXECUTE DFASINH >(dfidfo) ;
EXECUTE DFATANH >(dfidfo) ;
EXECUTE DFEXP >(dfidfo) ;
EXECUTE MthLfrexp
r[
&MathLibDF.
MathLibN >abs
2>r2>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
MathLibN @
;
EXECUTE MthLldexp
r[
&MathLibDF.
2>R >R 4>R
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE DFLN >(dfidfo) ;
EXECUTE DFLOG >(dfidfo) ;
EXECUTE MthLmodf
r[
&MathLibDF.
MathLibDF1 >abs
2>r2>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
MathLibDF1 DF@DF
;
EXECUTE DFEXPM1 >(dfidfo) ;
EXECUTE DFLNP1 >(dfidfo) ;
EXECUTE MthLlogb >(dfidfo) ;
EXECUTE MthLlog2 >(dfidfo) ;
EXECUTE DF**
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE DFSQRT >(dfidfo) ;
EXECUTE MthLhypot
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE MthLcbrt >(dfidfo) ;
EXECUTE MthLceil >(dfidfo) ;
EXECUTE MthLabs >(dfidfo) ;
EXECUTE DFLOOR >(dfidfo) ;
EXECUTE MthLfmod ( dr dr -- dr )
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
ROT 1+ ROT ROT \ skip isinf
: MthLisinf ( dr -- flag )
DUP (hex) 7FF0 DUP ROT AND = IF
(hex) 0F AND OR OR OR 0=
ELSE DFDROP FALSE THEN
;
ROT 1+ ROT ROT \ skip finite
: MthLfinite ( dr -- flag )
(hex) 7FF0 DUP ROT AND <> >R
DROP 2DROP R>
;
EXECUTE MthLscalbn
r[
&MathLibDF.
2>R >R 4>R
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE MthLdrem
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE MthLsignificand >(dfidfo) ;
ROT 1+ ROT ROT
: MthLcopysign
(hex) 8000 AND >R DROP 2DROP
(hex) 7FFF AND R> OR
;
ROT 1+ ROT ROT
: MthLisnan ( dr -- flag )
DUP (hex) 7FF0 DUP ROT AND = IF
(hex) F AND OR OR OR 0<>
ELSE DFDROP FALSE THEN
;
EXECUTE MthLilogb
r[
MathLibN >abs
2>r4>r
[ EXECUTE ]
]r MathLibN @
;
EXECUTE MthLrint >(dfidfo) ;
EXECUTE MthLnextafter
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE MthLremainder
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE MthLscalb
r[
&MathLibDF.
2>r4>r4>r
[ EXECUTE ]
]r MathLibDF DF@DF
;
EXECUTE DFROUND >(dfidfo) ;
EXECUTE MthLtrunc >(dfidfo) ;
ROT 1+ ROT ROT
: MthLsignbit ( dr -- ud )
(hex) 8000 AND >R
DROP 2DROP 0 R>
;

2DROP DROP

previous
end-module
